Usenet 1993 July/InfoMagic USENET CD-ROM July 1993.ISO/sources/misc/volume30/mserv-3.0/part03

Text File | 1992-06-19 | 54.6 KB | 2,056 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Johan Vromans)
Subject:  v30i048:  mserv-3.0 - Squirrel Mail Server Software, Part03/04
Message-ID: <[e-mail]>
X-Md4-Signature: c7d54ea4eab2114ecfa9b1287414bf36
Date: Sun, 14 Jun 1992 00:59:11 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Johan Vromans)
Posting-number: Volume 30, Issue 48
Archive-name: mserv-3.0/part03
Environment: Perl

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to [e-mail] if you want that tool.
# Contents:  Makefile do_report.pl dr_pack.pl dr_uucp.pl makeindex.pl
#   ms_lock.pl mserv_common.pl pr_doindex.pl pr_dowork.pl
#   pr_dsearch.pl pr_isearch.pl report.pl rfc822.pl testlock.pl
# Wrapped by kent@sparky on Sat Jun 13 19:46:22 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 3 (of 4)."'
if test -f 'Makefile' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'Makefile'\"
else
  echo shar: Extracting \"'Makefile'\" \(4519 characters\)
  sed "s/^X//" >'Makefile' <<'END_OF_FILE'
X# Makefile -- for mail server
X# SCCS Status     : %Z%@ %M%    %I%
X# Author          : Johan Vromans
X# Created On      : Fri May  1 15:44:47 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Wed Jun 10 14:24:51 1992
X# Update Count    : 69
X# Status          :
X
XSHELL    = /bin/sh
XCC    = gcc -Wall
XCFLAGS    = -O
X
X# Perl 4.019 or later
XPERL    = /usr/local/bin/perl
X# Where programs and files reside.
XLIBDIR    = /usr/local/lib/mserv
X# Where help data will be installed.
XPUBDIR    = $(LIBDIR)/pub
X# The owner of the mail server files
XSERVER    = mserv
X
X# Perl scripts that will be public executable.
XPEARLS    = process dorequest unpack makeindex chkconfig report do_report
X# Misc. files.
XFILES    = rfc822.pl mserv_common.pl \
X    ms_lock.pl \
X    dr_mail.pl dr_uucp.pl dr_pack.pl \
X    pr_isearch.pl pr_dsearch.pl pr_doindex.pl pr_dowork.pl
X# Config data. Will not replace existing files.
XCONFIG    = mserv_config.pl mserv.hints mserv.notes
X# Public executable shell scripts.
XSHELLS    = do_runq
X# These files will be created, if needed
XTOUCH    = logfile lockfile queue .errrun
X# Public services.
XAIDS    = HELP unpack.pl
X
Xall:    $(PEARLS) mlistener
X    @echo "Use \"make listener\" to generate the listener program"
X    @echo "Use \"make ixlookup\" if you selected index lookup"
X
X$(PEARLS) mlistener:
X    @for prog in $(PEARLS) mlistener; do \
X        echo "Preparing $$prog..."; \
X        rm -f $$prog; \
X        sed -e '1s|/usr/local/bin/perl|$(PERL)|' \
X            -e 's|/usr/local/lib/mserv|$(LIBDIR)|' \
X            $$prog.pl >$$prog; \
X    done
X
Xinstall: $(PEARLS)
X    -mkdir $(LIBDIR)
X    @for prog in $(PEARLS); do \
X        echo "Installing $$prog..."; \
X        install -m 0555 $$prog $(LIBDIR)/$$prog; \
X    done
X    @for prog in $(SHELLS); do \
X        echo "Installing $$prog..."; \
X        install -c -m 0555 $$prog.sh $(LIBDIR)/$$prog; \
X    done
X    @for prog in $(FILES); do \
X        echo "Installing $$prog..."; \
X        install -c -m 0444 $$prog $(LIBDIR); \
X    done
X    @for prog in $(TOUCH); do \
X        if [ -f $(LIBDIR)/$$prog ]; then \
X        true; \
X        else \
X        echo "Creating $$prog..."; \
X        cat < /dev/null > $(LIBDIR)/$$prog; \
X        fi; \
X    done
X    @for prog in $(CONFIG); do \
X        if [ -f $(LIBDIR)/$$prog ]; then \
X        echo "Installing $$prog as NEW-$$prog..."; \
X        echo "IMPORTANT: Update $$prog by hand if needed!"; \
X        install -c -m 0644 $$prog $(LIBDIR)/NEW-$$prog; \
X        else \
X        echo "Installing $$prog..."; \
X        install -c -m 0644 $$prog $(LIBDIR); \
X        fi \
X    done
X    -mkdir $(PUBDIR)
X    @for prog in $(AIDS); do \
X        echo "Installing $$prog in $(PUBDIR)..."; \
X        install -c -m 0444 $$prog $(PUBDIR)/$$prog; \
X    done
X    -(cd $(PUBDIR); rm -f help; ln HELP help)
X    @echo "Use \"make install-listener\" to install the listener program"
X    @echo "Use \"make install-ixlookup\" to install the ixlookup program"
X
X################ Listener ################
X
Xlistener: mlistener
X    rm -f listener listener.c
X    $(PERL) mlistener -verbose > listener.c
X    $(CC) $(CFLAGS) -o listener listener.c
X
X# Install setuid to the installer...
Xinstall-listener:    listener
X    rm -f $(LIBDIR)/listener
X    install -s -c listener $(LIBDIR)/listener
X    chmod -w,+x,u+s $(LIBDIR)/listener
X
X################ ixlookup ################
X
X# ixlookup is based on GNU find/locate.
X# If you have GNU find 3.6 or later, you can use the locate program.
X# For locate 3.5, a patch is available to create a customized version
X# of this program. "make ixlookup" will build it.
X# Set GNUFIND to indicate where the source of GNU locate, includes
X# and find lib can be found.
X# Reference version is GNU find 3.5.
XGNUFIND = /beethoven/arch/GNU/find-3.5
X
Xixlookup.c: $(GNUFIND)/locate/locate.c ixlookup.patch
X    rm -f ixlookup.c
X    cp  $(GNUFIND)/locate/locate.c ixlookup.c
X    patch -p0 -N < ixlookup.patch
X
Xixlookup:    ixlookup.c
X    rm -f ixlookup
X    $(CC) $(CFLAGS) '-DFCODES="$(LIBDIR)/find.codes"' \
X        -I$(GNUFIND)/lib -o ixlookup ixlookup.c \
X        $(GNUFIND)/lib/libfind.a
X
Xinstall-ixlookup:    ixlookup
X    install -s -m 0555 -c ixlookup $(LIBDIR)
X
X################ Cleanup ################
X
Xclean:
X    rm -f *~ core a.out $(PEARLS) mlistener listener listener.c \
X    *.orig *.rej ixlookup.c ixlookup
X
X################ Maintenance ################
X
Xtar.Z:;    pdtar -zcv -T MANIFEST -f mserv.tar.Z
X
Xdiffs:
X    rm -f mserv.diffs
X    -while read file junk; do \
X        diff -c dist/$$file $$file >> mserv.diffs; \
X    done < MANIFEST
X    compress < mserv.diffs > mserv.DZ
X
XAUX   = Makefile mserv_config.pl ChangeLog* Misc
XTZ:;    tar cvf - $(AUX) SCCS | compress > mserv.TZ
X
Xshar:
X    rm -f mserv-*.shar.*
X    shar -p -f -F \
X        -L 30 -o mserv-3.0.shar \
X        -a -n mserv-3.0.shar -s 'Johan Vromans <[e-mail]>' \
X        -S < MANIFEST
X    ls -l mserv-*.shar.*
X
END_OF_FILE
  if test 4519 -ne `wc -c <'Makefile'`; then
    echo shar: \"'Makefile'\" unpacked with wrong size!
  fi
  # end of 'Makefile'
fi
if test -f 'do_report.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'do_report.pl'\"
else
  echo shar: Extracting \"'do_report.pl'\" \(4485 characters\)
  sed "s/^X//" >'do_report.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# do_report.pl -- run mail server report
X# SCCS Status     : @(#)@ do_report    1.5
X# Author          : Johan Vromans
X# Created On      : Sat May  2 14:15:16 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Sat May  9 00:00:17 1992
X# Update Count    : 33
X# Status          : OK
X
X$my_name = "do_report";
X$my_version = "1.5";
X#
X################ Common stuff ################
X
X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
Xunshift (@INC, $libdir);
Xrequire "mserv_common.pl";
X
X################ Presets ################
X
X@args = ();
X@dest = ( $mserv_owner );
X
X################ Options handling ################
X
X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
Xprint ($my_package, " [", $my_name, " ", $my_version, "]\n")
X    if $opt_ident;
X@dest = @ARGV if @ARGV > 0;
X
X################ Main ################
X
X$tmpfile_prefix = "/usr/tmp/rpt$$.";
X$rpt = $tmpfile_prefix . "rpt";
X$err = $tmpfile_prefix . "err";
X$oldlog = $logfile . ".o";
X
Xif ( $opt_collect ) {
X    # Seize logfile.
X    &die ("Found $oldlog, will not proceed") if -s $oldlog;
X    &unlink ($oldlog);
X
X    if ( &rename ($logfile, $oldlog) ) {
X    open (LOG, ">".$logfile) && close (LOG);
X    }
X    else {
X    &die ("Cannot rename $logfile to $oldlog [$!]");
X    }
X
X    # Run report.
X    &system ("$libdir/report @args $oldlog >$rpt 2>$err");
X}
Xelse {
X    &system ("$libdir/report @args >$rpt 2>$err");
X}
X
Xif ( $opt_collect ) {
X
X    # Append to accumulating data and compress (again).
X    if ( -f $logfile . ".cum.Z") {
X    &system ("uncompress $logfile.cum");
X    &system ("cat $oldlog >> $logfile.cum");
X    &unlink ($oldlog);
X    &system ("compress $logfile.cum");
X    }
X    else {
X    &system ("cat $oldlog >> $logfile.cum");
X    &unlink ($oldlog);
X    # &system ("compress $logfile.cum");
X    }
X}
X
X&cleanup;
X
X################ Subroutines ################
X
Xsub cleanup {
X    &mail ($err, "ERRORS from Mail Server") if -s $err;
X    &mail ($rpt, "Mail Server Report") if -s $rpt;
X    &unlink ($rpt, $err);
X}
X
Xsub unlink {
X    local (@files) = @_;
X    print STDERR ("+ unlink @files\n") if $opt_trace;
X    unlink (@files);
X}
X
Xsub rename {
X    local ($old, $new) = @_;
X    print STDERR ("+ rename $old $new\n") if $opt_trace;
X    rename ($old, $new);
X}
X
Xsub system {
X    local ($cmd) = (@_);
X    local ($ret);
X    print STDERR ("+ $cmd\n") if $opt_trace;
X    $ret = system ($cmd);
X    &die (sprintf ("Return 0x%x from \"$cmd\"", $ret))
X    unless $ret == 0;
X    $ret;
X}
X
Xsub warn {
X    local ($msg) = (@_);
X    warn ($my_name . ": " . $msg . "\n");
X}
X
Xsub die {
X    &warn;
X    &cleanup;
X    exit (1);
X}
X
Xsub mail {
X    local ($file, $subj) = @_;
X    local ($cmd) = "$sendmail '" . join("' '", @dest) . "'";
X
X    # DO NOT USE '&die' in this routine.
X
X    print STDERR ("+ |", $cmd, "\n") if $opt_trace;
X
X    open (MAIL, "|" . $cmd)
X    || die ("$my_name: Cannot invoke $cmd [$!]\n");
X    print MAIL ("To: ", join(", ", @dest), "\n",
X        "Subject: $subj\n",
X        "\n");
X    if ( open (FILE, $file) ) {
X    while ( <FILE> ) {
X        print MAIL $_;
X    }
X    close (FILE);
X    }
X    close (MAIL);
X    die ("$my_name: Mail error $?\n") if $?;
X}
X
Xsub options {
X    require "newgetopt.pl";
X    $opt_ident = $opt_help = 0;
X    $opt_errors = $opt_usage = $opt_full = 0;
X    $opt_collect = $opt_trace = $opt_noupdate = 0;
X    if ( !&NGetOpt ("ident", "errors", "usage", "full", "collect",
X            "since=s", "noupdate",
X            "trace", "help")
X    || $opt_help ) {
X    &usage;
X    }
X    $opt_errors |= $opt_full;
X    $opt_usage |= $opt_full;
X    $opt_usage = 1 unless $opt_errors;
X    unshift (@args, "-full") if $opt_usage && $opt_errors;
X    unshift (@args, "-errors") if $opt_errors && !$opt_usage;
X    unshift (@args, "-since", $opt_since) if defined $opt_since;
X    unshift (@args, "-noupdate") if $opt_noupdate;
X    unshift (@args, "-usage") if $opt_usage && !$opt_errors;
X    undef $opt_errors, $opt_full, $opt_usage;
X}
X
Xsub usage {
X    print STDERR <<EndOfUsage;
X$my_package [$my_name $my_version]
X
XUsage: $my_name [options] [ recipients... ]
X
XOptions:
X    -usage    generate usage report to STDOUT
X    -full    generate usage report and error report
X    -collect    collect and cleanup logfile data
X    -since FILE    only error messages newer than FILE
X        (FILE date will be updated upon successful completion)
X    -noupdate    do not update FILE date
X    -help    this message
X    -trace    show commands
X    -ident    print identification
X
XDefault action is to generate a usage report, and to mail it to the
Xrecipients (default: $mserv_owner).
XEndOfUsage
X    exit (1);
X}
END_OF_FILE
  if test 4485 -ne `wc -c <'do_report.pl'`; then
    echo shar: \"'do_report.pl'\" unpacked with wrong size!
  fi
  # end of 'do_report.pl'
fi
if test -f 'dr_pack.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dr_pack.pl'\"
else
  echo shar: Extracting \"'dr_pack.pl'\" \(2769 characters\)
  sed "s/^X//" >'dr_pack.pl' <<'END_OF_FILE'
X# dr_pack.pl -- handle packing
X# SCCS Status     : @(#)@ dr_pack.pl    3.1
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 22:22:49 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Thu Jun  4 23:07:22 1992
X# Update Count    : 6
X# Status          : OK
X
Xsub pack_mail_request {
X    local ($rcpt, $dest, $request, $file, $coding, $limit, $packing, $parts) = @_;
X
X    if ( $opt_debug ) {
X    print STDERR ("&pack_mail_request(rcpt=$rcpt, address=$dest, ",
X              "request=$request,\n",
X              "    file=$file,\n",
X              "    limit=$limit, packing=$packing, parts=$parts)\n");
X    }
X
X    ($request, $file) = &packing ($request, $file, $packing);
X    require "$libdir/dr_mail.pl";
X    &mail_request ($rcpt, $dest, $request, $file, $coding, $limit, $parts);
X    unlink ($file) unless $opt_keep;
X}
X
Xsub pack_uucp_request {
X    local ($rcpt, $uupath, $uunote, $request, $file, $limit, $packing, $parts) = @_;
X
X    if ( $opt_debug ) {
X    print STDERR ("&pack_uucp_request(rcpt=$rcpt, uupath=$uupath,\n",
X              "    uunote=$uunote, request=$request,\n",
X              "    file=$file,\n",
X              "    limit=$limit, oacking=$packing, parts=$parts)\n");
X    }
X
X    ($request, $file) = &packing ($request, $file, $packing);
X    require "$libdir/dr_uucp.pl";
X    &uucp_request ($rcpt, $uupath, $uunote, $request, $file, $limit, $parts);
X    unlink ($file) unless $opt_keep;
X}
X
Xsub packing {
X    local ($request, $file, $packing) = @_;
X
X    # Packs the files in directory $file into an $packing-archive, and
X    # returns an array containing the modified name of the request
X    # and the name of the archive file.
X
X    &check_file ($file, 1);
X
X    local ($dir, $realname) = &fnsplit ($file);
X    local ($tmpfile_prefix) = $opt_keep || "$tmpdir/pck$$.";
X    local ($cmd) = "$find $realname -follow -type f ! -name '.*' -print | ";
X
X    chdir $dir || &die ("Cannot chdir to $dir [$!]");
X
X    if ( $packing eq "tar" ) {
X    $file = $tmpfile_prefix . "tar.Z";
X    $cmd .= $pdtar ? "$pdtar -z -c -h -T - -f $file"
X        : "$tar -c -h -T - -f - | $compress > $file";
X    &system ($cmd);
X    &die ("Problem executing \"$cmd\"") unless -s $file;
X    return ($request . "-tar.Z", $file);
X    }
X
X    if ( $packing eq "zoo" ) {
X    $file = $tmpfile_prefix . "zoo";
X    $cmd .= "$zoo aIqq $file";
X    &system ($cmd);
X    &die ("Problem executing \"$cmd\"") unless -s $file;
X    return ($request . "-zoo", $file);
X    }
X
X    if ( $packing eq "zip" ) {
X    $file = $tmpfile_prefix . "zip";
X    # It is not really necessary to use find for zip,
X    # but this is the only way to exclude .-files.
X    $cmd .= "$zip -n -q -b $tmpdir $file -";
X    &system ($cmd);
X    &die ("Problem executing \"$cmd\"") unless -s $file;
X    return ($request . "-zip", $file);
X    }
X
X    &die ("Invalid packing code in queue");
X    (undef, undef);
X}
X
X1;
END_OF_FILE
  if test 2769 -ne `wc -c <'dr_pack.pl'`; then
    echo shar: \"'dr_pack.pl'\" unpacked with wrong size!
  fi
  # end of 'dr_pack.pl'
fi
if test -f 'dr_uucp.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'dr_uucp.pl'\"
else
  echo shar: Extracting \"'dr_uucp.pl'\" \(2794 characters\)
  sed "s/^X//" >'dr_uucp.pl' <<'END_OF_FILE'
X# dr_uucp.pl -- handle request via uucp
X# SCCS Status     : @(#)@ dr_uucp.pl    3.1
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 22:22:49 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Thu Jun  4 23:07:07 1992
X# Update Count    : 4
X# Status          : OK
X
Xsub uucp_request {
X
X    local ($rcpt, $uupath, $uunote, $request, $file, $limit, $parts) = @_;
X
X    if ( $opt_debug ) {
X    print STDERR ("&uucp_request(rcpt=$rcpt, uupath=$uupath,\n",
X              "    uunote=$uunote, request=$request,\n",
X              "    file=$file,\n",
X              "    limit=$limit, parts=$parts)\n");
X    }
X
X    # This routine handles the requests.
X
X    &check_file ($file, 0);
X
X    local ($fname);        # Basename of file to send
X    local ($size);        # Size of file
X    local ($files);        # Number of files to send
X    local (@parts);        # List of parts to send
X    local ($tmpfile_prefix) = $opt_keep || "$tmpdir/drq$$.";
X
X    # Limit must be between 10 and 1024K, with 256K default.
X    $limit =   32*1024 unless defined $limit;
X    $limit = $` * 1024 if $limit =~ /K$/;
X    $limit =   10*1024 if $limit <   10*1024;
X    $limit = 1024*1024 if $limit > 1024*1024;
X
X    # Get last part (basename) of the requested file.
X    $fname = (&fnsplit ($request))[1];
X
X    $size = (stat ($file))[7];
X    if ( $size > $limit ) {
X
X    open (F, $file) || &die ("Cannot read $file [$!]");
X
X    $files = int (($size - 1 ) / $limit) + 1;
X    print STDERR ("Size = $size, files = $files\n")
X        if $opt_debug;
X
X    if (  $parts =~ /\S/ ) {
X        @parts = grep ($_ && $_ <= $files, split (/,/, $parts));
X    }
X    else {
X        @parts = (1..$files);
X    }
X
X    foreach $the_part ( @parts ) {
X
X        local ($cnt) = 0;
X        local ($need) = $limit;
X        local ($uutmp) = $tmpfile_prefix . "uu";
X
X        print STDERR ("Sending $file, part $the_part of $files\n")
X        if $opt_debug;
X
X        seek (F, ($the_part-1) * $limit, 0);
X        open (S, ">$uutmp") || &die ("Cannot create $uutmp [$!]");
X        while ( $need > 0 ) {
X        local ($try) = 10240;
X        $try = $need if $try > $need;
X        $res = sysread (F, $buf, $try);
X        last unless defined $res && $res > 0;
X        syswrite (S, $buf, $res);
X        $need -= $res;
X        $cnt += $res;
X        }
X        close (S);
X
X        # Send it (w/ copy to UUCP spool).
X        &system ("$uucp -d -r -C -n$uunote $uutmp ".
X             "$uupath/$fname/part" .
X             sprintf ("%02dof%02d", $the_part, $files));
X
X        # Write a log message.
X        $uupath =~ /!/;
X        &writelog ("U \"$`!$uunote\" $request $the_part/$files $cnt");
X
X        unlink ($uutmp) unless $opt_keep;
X    }
X    close (F);
X    }
X    else {
X    print STDERR ("Sending file: ", $file, "\n")
X        if $opt_debug;
X
X    # Send it. Prevent copy to spool.
X    &system ("$uucp -d -r -c -n$uunote $file $uupath/$fname");
X
X    # Write a log message.
X    $uupath =~ /!/;
X    &writelog ("U \"$`!$uunote\" $request 1/1 $size");
X    }
X}
X
X1;
END_OF_FILE
  if test 2794 -ne `wc -c <'dr_uucp.pl'`; then
    echo shar: \"'dr_uucp.pl'\" unpacked with wrong size!
  fi
  # end of 'dr_uucp.pl'
fi
if test -f 'makeindex.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'makeindex.pl'\"
else
  echo shar: Extracting \"'makeindex.pl'\" \(3201 characters\)
  sed "s/^X//" >'makeindex.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# makeindex.pl -- make index for mail server
X# SCCS Status     : @(#)@ makeindex    1.7
X# Author          : Johan Vromans
X# Created On      : Tue Apr 21 20:36:56 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Wed May 20 13:37:13 1992
X# Update Count    : 23
X# Status          : Going steady
X
X# makeindex.pl, based on GNU find's updatedb.
X$my_name = "makeindex";
X$my_version = "1.7";
X#
X################ Common stuff ################
X
X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
Xunshift (@INC, $libdir);
Xrequire "mserv_common.pl";
X
X################ Options handling ################
X
X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
X@ARGV = ("-") unless @ARGV > 0;
Xprint STDERR "$my_package [$my_name $my_version]\n"
X    if defined $opt_ident;
X
X################ Setup ################
X
X&die ("Index search not selected -- nothing to do")
X    unless $doindexsearch;
X
X# Work files.
X$bigrams  = "$tmpdir/f.bigrams$$";
X$filelist = "$tmpdir/f.list$$";
X$errs     = "$tmpdir/f.errs$$";
X
X$SIG{"INT"}  = "catch";
X$SIG{"QUIT"} = "catch";
X$SIG{"HUP"}  = "IGNORE";
X$SIG{"TERM"} = "catch";
X
X################ Go! ################
X
Xif ( $indexfile =~ m|^/| ) {
X    # Create one single index file.
X    &makeindex (defined $indexlib ? $indexlib : "@libdirs", $indexfile);
X}
Xelse {
X    # Create one index file per library dir.
X    foreach $lib ( @libdirs ) {
X    &makeindex ($lib, "$lib/$indexfile");
X    }
X}
X
Xexit (0);
X
X################ Subroutines ################
X
Xsub makeindex {
X    local ($list, $index) = @_;
X
X    # Make a file list.  Alphabetize '/' before any other char with 'tr'.
X    &system ("$gfind $list ! -type d -follow -printf \"%P\\t%k\\t%Ty%Tm%Td\\n\"" .
X         "| tr '/' '\\001' | sort -f 2> $errs " .
X         "| tr '\\001' '/' > $filelist");
X
X    # Compute common bigrams.
X    &system ("$locatelib/bigram < $filelist | sort 2>> $errs | uniq -c " .
X         "| sort -nr | awk '{ if (NR <= 128) print \$2 }' " .
X         "| tr -d '\\012' > $bigrams");
X
X    printf STDERR ($my_name, ": Out of sort space\n")
X    if -s $errs;
X
X    # Code the file list.
X    &system ("$locatelib/code $bigrams < $filelist > $index~");
X    &rename ("$index~", $index);
X    chmod (0644, $index);
X
X    &cleanup;
X}
X
Xsub system {
X    local ($cmd) = (@_);
X    local ($ret);
X    print STDERR ("+ $cmd\n");
X    $ret = system ($cmd);
X    &die (sprintf ("Return 0x%x from \"$cmd\"", $ret))
X    unless $ret == 0;
X    $ret;
X}
X
Xsub rename {
X    local ($old, $new) = @_;
X    print STDERR ("+ rename $old $new\n");
X    rename ($old, $new) || &system ("mv $old $new");
X}
X
Xsub die {
X    local ($msg) = (@_);
X    warn ($my_name . ": " . $msg . "\n");
X    &cleanup;
X    exit (1);
X}
X
Xsub catch {
X    print STDERR ("+ Ouch!\n");
X    &cleanup;
X    exit(1);
X}
X
Xsub cleanup {
X    unlink ($bigrams, $filelist, $errs);
X}
X
Xsub options {
X    require "newgetopt.pl";
X    if ( !&NGetOpt ("debug", "ident", "trace", "help")
X    || defined $opt_help ) {
X    &usage;
X    }
X}
X
Xsub usage {
X    print STDERR <<EndOfUsage;
X$my_package [$my_name $my_version]
X
XUsage: $my_name [options]
X
XOptions:
X    -help    this message
X    -trace    show commands
X    -ident    show identification
X    -debug    for debugging
XEndOfUsage
X    exit (!defined $opt_help);
X}
END_OF_FILE
  if test 3201 -ne `wc -c <'makeindex.pl'`; then
    echo shar: \"'makeindex.pl'\" unpacked with wrong size!
  fi
  # end of 'makeindex.pl'
fi
if test -f 'ms_lock.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'ms_lock.pl'\"
else
  echo shar: Extracting \"'ms_lock.pl'\" \(2911 characters\)
  sed "s/^X//" >'ms_lock.pl' <<'END_OF_FILE'
X# ms_lock.pl -- locking
X# SCCS Status     : @(#)@ ms_lock.pl    3.1
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 21:22:45 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Sat Jun  6 21:01:29 1992
X# Update Count    : 67
X# Status          : OK
X
X# This file defines the function 'locking' as follows:
X#
X#    &locking (*FH, $wait)
X#
X#    FH is a handle to an opened file, with r/w access.
X#    $wait indicates if the process is to wait for the lock.
X#
X# Return values:
X#     1  lock succeeded
X#     0  lock not succeeded, $wait == 0
X#    -1  lock failed
X#
X# Preferrably, &locking is implemented using the fcntl(2) system
X# call that is available on most modern systems.
X# As an alternative, code is included to use flock(2) style locking
X# available on BSD systems.
X# Also code is included to use lockf(2), but this has not been tested.
X# Note that this is lockf(2), not lockf(3): the system call, not the
X# library routine.
X#
X# The functioning of this module can be tested using the program
X# testlock.pl.
X
Xif ( defined $lock_fcntl && $lock_fcntl ) {
X    eval <<'EOD';
X    sub locking {            # using fcntl(2)
X        local (*FH, $wait) = @_;
X
X        require "errno.ph";
X        require "fcntl.ph";
X
X        local ($func) =
X        $wait ? &F_SETLKW    # set lock and wait for it
X            : &F_SETLK;        # don't wait for it
X        local ($lck) =
X        pack ("sslli",    # see man for flock(2)
X              &F_WRLCK,    # short l_type (F_WRLCK: write lock)
X              0,    # short l_whence (as in lseek(2))
X              0,    # long l_start (start of region)
X              0,    # long l_len (0 -> whole file)
X              0);    # int l_pid (not used)
X        local ($ret) = fcntl (FH, $func, $lck);
X        return 1 if $ret eq "0 but true";
X        # print STDERR ("=> ret = $ret, \$! = $! [", 0+$!, "]\n");
X        return 0 if $! == &EACCES && !$wait;
X        -1;            # failed
X    }
XEOD
X}
Xelsif ( defined $lock_flock && $lock_flock ) {
X    eval <<'EOD';
X    sub locking {            # using flock(2)
X        local (*FH, $wait) = @_;
X
X        require "sys/file.ph";
X        require "errno.ph";
X
X        local ($wp) = &LOCK_EX;
X        $wp |= &LOCK_NB unless $wait;
X        local ($ret) = flock (FH, $wp);
X        return 1 if $ret;
X        # print STDERR ("=> ret = $ret, \$! = $! [", 0+$!, "]\n");
X        return 0 if $! == &EWOULDBLOCK && !$wait;
X        -1;                # failed
X    }
XEOD
X}
Xelsif ( defined $lock_lockf && $lock_lockf) {
X    eval <<'EOD';
X    sub locking {            # using lockf(2) **UNTESTED**
X        local (*FH, $wait) = @_;
X
X        require "errno.ph";
X        require "unistd.ph";
X        require "sys/syscall.ph";
X
X        local ($func) = $wait ? &F_LOCK : &F_TLOCK;
X        local ($here) = tell (FH);
X
X        seek (FH, 0, 0);
X        local ($ret) = syscall (&SYS_lockf, fileno(FH), $func, 0);
X        seek (FH, $here, 0);
X        return 1 if $ret == 0;
X        return 0 if $! == &EACCES && !$wait;
X        -1;                # failed
X    }
XEOD
X}
Xelse {
X    eval <<'EOD';
X    sub locking {            # no locking
X        local (*FH, $wait) = @_;
X        return $wait ? 1 : 0;
X    }
XEOD
X}
X
X1;
END_OF_FILE
  if test 2911 -ne `wc -c <'ms_lock.pl'`; then
    echo shar: \"'ms_lock.pl'\" unpacked with wrong size!
  fi
  # end of 'ms_lock.pl'
fi
if test -f 'mserv_common.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'mserv_common.pl'\"
else
  echo shar: Extracting \"'mserv_common.pl'\" \(1911 characters\)
  sed "s/^X//" >'mserv_common.pl' <<'END_OF_FILE'
X# mserv_common.pl -- common info for mail server
X# SCCS Status     : @(#)@ mserv_common    1.13
X# Author          : Johan Vromans
X# Created On      : Fri Apr 17 11:02:58 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Wed Jun 10 14:16:28 1992
X# Update Count    : 68
X# Status          : OK
X
X################ Preamble ################
X#
X# Package info. Do not change this.
X$my_package = "Squirrel Mail Server Software V3.00";
X#
Xrequire "mserv_config.pl";
Xrequire "ms_lock.pl";
X#
X# It is not always clear if 'not setting' means 'not defining' or
X# 'leaving it empty'.
X# This guarantees some consistency.
X
X$chunkmail = $sendmail
X    unless defined $chunkmail && $chunkmail ne "";
X$mserv_bcc = ""
X    unless defined $mserv_bcc;
Xundef $sender
X    unless defined $sender && $sender ne "";
Xundef $mailer_delay
X    unless defined $mailer_delay && $mailer_delay > 0;
Xundef $lockfile
X    unless defined $lockfile && $lockfile ne "";
Xundef $lock_lockf
X    unless defined $lock_lockf && $lock_lockf != 0;
Xundef $lock_flock
X    unless defined $lock_flock && $lock_flock != 0;
Xundef $lock_fcntl
X    unless defined $lock_fcntl && $lock_fcntl != 0;
Xundef $sender
X    unless defined $sender && $sender ne "";
Xundef @x_headers
X    unless defined @x_headers && @x_headers ne 0;
Xundef $logfile
X    unless defined $logfile && $logfile ne "";
Xundef $indexfile
X    unless defined $indexfile && $indexfile ne "";
Xundef $indexlib
X    unless defined $indexfile && defined $indexlib && $indexlib ne "";
X$maxindexlines = 0
X    unless defined $maxindexlines && $maxindexlines > 0;
Xundef $uucp
X    unless defined $uucp && $uucp ne "";
X$uuname = ""
X    unless defined $uuname;
Xundef $packing_limit
X    unless defined $packing_limit && $packing_limit > 0;
Xundef $pdtar
X    unless defined $pdtar && $pdtar ne "";
X$auto_runrequest = 0
X    unless defined $auto_runrequest && $auto_runrequest > 0;
X
X################ 1 ################
X1;
X
END_OF_FILE
  if test 1911 -ne `wc -c <'mserv_common.pl'`; then
    echo shar: \"'mserv_common.pl'\" unpacked with wrong size!
  fi
  # end of 'mserv_common.pl'
fi
if test -f 'pr_doindex.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'pr_doindex.pl'\"
else
  echo shar: Extracting \"'pr_doindex.pl'\" \(1804 characters\)
  sed "s/^X//" >'pr_doindex.pl' <<'END_OF_FILE'
X# pr_doindex.pl -- execute index requests
X# SCCS Status     : @(#)@ pr_doindex.pl    3.2
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 22:15:51 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Wed Jun 10 13:10:07 1992
X# Update Count    : 3
X# Status          : OK
X
Xsub index_loop {
X
X    local ($entries) = 0;
X    local ($name, $size, $date);
X    local ($tally);
X    local ($list_type) = "Index";
X    local ($limit);
X
X    print STDOUT ("Index results:\n");
X
X    foreach $query ( @indexq ) {
X
X    $~ = "list_header";
X    write;
X    $~ = "list_format";
X    $: = " /";        # break filenames at logical places
X    $= = 99999;
X    $tally = 0;
X    $limit = $maxindexlines > 0 ? $maxindexlines : 65535;
X
X    if ( $indexfile =~ m|^/| ) {
X        if ( -r "$indexfile" ) {
X        print STDOUT ("Index $query in $indexfile...\n")
X            if $opt_debug;
X        $ENV{"LOCATE_DB"} = $indexfile;
X        open ( IX, "$ixlookup '$query' |");
X        while ( <IX> ) {
X            ($name, $size, $date) = /^(.+)\?(\d+)\?(\d+)$/;
X            $date =~ s|^(..)(..)(..)|1900+$1."/$2/$3"|e;
X            $size .= "K";
X            write;
X            last if ++$tally >= $limit;
X        }
X        close (IX);
X        }
X    }
X    else {
X        foreach $lib ( @libdirs ) {
X        next unless -r "$lib/$indexfile" || $tally > $limit;
X        print STDOUT ("Index $query in $lib/$indexfile...\n")
X            if $opt_debug;
X        $ENV{"LOCATE_DB"} = "$lib/$indexfile";
X        open ( IX, "$ixlookup '$query' |");
X        while ( <IX> ) {
X            ($name, $size, $date) = /^(.+)\?(\d+)\?(\d+)$/;
X            $date =~ s|^(..)(..)(..)|1900+$1."/$2/$3"|e;
X            $size .= "K";
X            write;
X            last if ++$tally >= $limit;
X        }
X        close (IX);
X        }
X    }
X    if ( $tally == 0 ) {
X        $name = "***not found***";
X        write;
X    }
X    elsif ( $tally >= $limit ) {
X        print STDOUT ("*** Too much output, remaining lines flushed ***\n");
X    }
X    }
X    print STDOUT ("\n");
X}
X
X1;
END_OF_FILE
  if test 1804 -ne `wc -c <'pr_doindex.pl'`; then
    echo shar: \"'pr_doindex.pl'\" unpacked with wrong size!
  fi
  # end of 'pr_doindex.pl'
fi
if test -f 'pr_dowork.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'pr_dowork.pl'\"
else
  echo shar: Extracting \"'pr_dowork.pl'\" \(5301 characters\)
  sed "s/^X//" >'pr_dowork.pl' <<'END_OF_FILE'
X# pr_dowork.pl -- execute work loop
X# SCCS Status     : @(#)@ pr_dowork.pl    3.1
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 22:14:50 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Thu Jun  4 23:06:00 1992
X# Update Count    : 3
X# Status          : OK
X
Xsub work_loop {
X
X    local ($def_encoding) = $default_encoding;
X    local ($packing) = "";
X    local ($limit) = $limits[1];
X    local ($uupath) = "";
X    local ($uunote) = "";
X    local ($entries);
X    local (@work);
X    local ($type);
X    local ($sender) = $sender;
X    local ($queueq) = ();
X
X    return unless defined ($entries = grep (/^S/, @workq)) && $entries > 0;
X
X    if ( $opt_debug || $opt_trace ) {
X    print STDOUT ("=> Work queue:\n");
X    local ($tally) = 0;
X    foreach $i ( @workq ) {
X        $tally++;
X        printf STDOUT ("  %3d: %s\n", $tally, join(" ", &zu ($i)));
X    }
X    print STDOUT ("\n");
X    }
X
X    $entries = 0;
X
X    foreach $work ( @workq ) {
X
X    ($type, @work) = &zu ($work);
X    last unless defined $type;
X
X    if ( $type eq "L" ) {
X        $limit = $work[0];
X        next;
X    }
X
X    if ( $type eq "E" ) {
X        $def_encoding = $work[0];
X        next;
X    }
X
X    if ( $type eq "M" ) {
X        $destination = $work[0];
X        next;
X    }
X
X    if ( $type eq "P" ) {
X        $packing = $work[0];
X        next;
X    }
X
X    if ( $type eq "U" ) {
X        ($uupath, $uunote) = @work;
X        next;
X    }
X
X    if ( $type eq "S" ) {
X
X        local (@found);        # return from search
X        local ($name, $size, $date, $lib, $subdir); # elements of @found
X        local ($request, $plist) = @work;
X        local ($remarks) = "";
X        local ($limit) = $limit . "K";
X        local ($coding) = $def_encoding;
X
X        if ( $packing ) {
X        @found = ();
X        foreach $lib ( @libdirs ) {
X            print STDOUT ("Trying dir $lib/$request...\n")
X            if $opt_debug;
X            push (@found, $lib)
X            if -d "$lib/$request" && -r _;
X        }
X        if ( @found == 1 ) {
X            local ($lib) = $found[0];
X            print STDOUT ("Sizing dir $lib/$request... ")
X            if $opt_debug;
X            $size = `$du -s $lib/$request` + 0;
X            print STDOUT ($size, " blocks.\n")
X            if $opt_debug;
X            if ($size > $packing_limit) {
X            push (@queueq,
X                  &zp ($request . "/ (" . $packing . ")",
X                   "", "", "", "Request too big"));
X            }
X            else {
X
X            # Put the request in the batch queue.
X            if ( $opt_noqueue ) {
X                $remarks = "Tested OK";
X                $entries++;
X            }
X            elsif ( $method eq "M" ) {
X                $remarks =
X                &enqueue ("MP", $recipient, $destination,
X                      $request, "$lib/$request",
X                      $coding, $limit, $packing,
X                      $plist);
X            }
X            elsif ( $method eq "U" ) {
X                $remarks =
X                &enqueue ("UP", $recipient, $uupath, $uunote,
X                      $request, "$lib/$request",
X                      $limit, $packing, $plist);
X            }
X            push (@queueq,
X                  &zp ($request . "/ (" . $packing . ")",
X                   int(($size+1) / 2) . "K",
X                   $coding, $limit, $remarks));
X            }
X        }
X        elsif ( @found == 0 ) {
X            push (@queueq,
X              &zp ($request . "/ (" . $packing . ")",
X                   "", "", "", "Not found"));
X        }
X        else {
X            # Ambiguous.
X            print STDOUT ("Directory \"$request\" is not unique in the archives.\n",
X                  "This request has been skipped.\n\n");
X            push (@queueq,
X              &zp ($request . "/ (" . $packing . ")",
X                   "", "", "", "Ambiguous"));
X        }
X        next;
X        }
X
X        # Locate them.
X        @found = &search ($request, 0);
X
X        if ( @found > 1 ) {
X        print STDOUT ("Request \"$request\" is ambiguous:\n");
X        &dolist ("Search", $request, *found);
X        print STDOUT ("\n");
X        push (@queueq,
X              &zp ($request, "", "", "", "Ambiguous"));
X        next;
X        }
X
X        ($name, $size, $date, $lib, $subdir) = &zu ($found[0]);
X
X        # Make sure that we have one single file.
X        if ( @found == 0 || ! -f $lib.$subdir.$name ) {
X        push (@queueq,
X              &zp ($request, "", "", "", "Not found"));
X        next;
X        }
X
X        # Send some files in plain (ascii) format.
X        $coding = "A" if ($name !~ /$extpat$/ || $+ eq ".shar")
X        && -T $lib.$subdir.$name ;
X
X        $size = int(($size+1023)/1024) . "K" unless $size =~ /K$/;
X
X        # Put the request in the batch queue.
X        if ( $opt_noqueue ) {
X        $remarks = "Tested OK";
X        $entries++;
X        }
X        elsif ( $method eq "M" ) {
X        $remarks =
X            &enqueue ("M", $recipient, $destination, $subdir.$name,
X                  $lib.$subdir.$name,
X                  $coding, $limit, $plist);
X        }
X        elsif ( $method eq "U" ) {
X        $remarks =
X            &enqueue ("U", $recipient, $uupath, $uunote, $subdir.$name,
X                  $lib.$subdir.$name,
X                  $limit, $plist);
X        }
X
X        push (@queueq,
X          &zp ($subdir.$name, $size, $coding, $limit, $remarks));
X        next;
X    }
X
X    # Should not happen.
X    print STDOUT ("*** Mail Server internal error: ",
X              "Request type \"$type\" in work queue ***\n");
X    }
X
X    if ( @queueq > 0 ) {
X    print STDOUT ("Request results:\n");
X    $~ = $method . "_header";
X    write;
X    $~ = $method . "_list";
X    $: = " /";
X    $= = 99999;
X
X    foreach $entry ( @queueq ) {
X        local ($name, $size, $coding, $limit, $remarks) = &zu ($entry);
X        write;
X    }
X
X    if ( $entries > 0 ) {
X        print STDOUT ("\nThe requests with status \"Queued\"",
X              " will be sent as soon as the load of\n",
X              "the server system permits, ",
X              "usually within 24 hours.\n");
X    }
X    else {
X        print STDOUT ("\nNo requests remain to be send.\n");
X    }
X    }
X    else {
X    print STDOUT ("\nNo requests remain to be send.\n");
X    }
X}
X
X1;
END_OF_FILE
  if test 5301 -ne `wc -c <'pr_dowork.pl'`; then
    echo shar: \"'pr_dowork.pl'\" unpacked with wrong size!
  fi
  # end of 'pr_dowork.pl'
fi
if test -f 'pr_dsearch.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'pr_dsearch.pl'\"
else
  echo shar: Extracting \"'pr_dsearch.pl'\" \(2649 characters\)
  sed "s/^X//" >'pr_dsearch.pl' <<'END_OF_FILE'
X# pr_dsearch.pl -- directory search
X# SCCS Status     : @(#)@ pr_dsearch.pl    3.1
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 22:13:23 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Thu Jun  4 23:05:39 1992
X# Update Count    : 4
X# Status          : OK
X
Xsub dirsearch {
X
X    local ($libdir, $request) = @_;
X
X    # Locate an archive item $request in library $libdir by
X    # performing a directory lookup.
X    # Eligible items are in the format XXX.EXT, or XXX-VVV.EXT, where
X    # VVV is assumed to be a version indicator (and must start with a digit).
X    # If an eligible item appears to be a directory, the search continues
X    # recursively.
X    #
X    # See "sub search" for a description of the return values.
X
X    local ($size);
X    local (@retval);        # return value
X    local (@a);            # to hold stat() result
X
X    # Normalize the request.
X    # $tryfile will be the basename of the request.
X    # $subdir holds the part between $libdir and $tryfile.
X    local ($subdir, $tryfile) = &fnsplit ($request);
X
X    print STDOUT ("Search $libdir$subdir for $tryfile...\n") if $opt_debug;
X
X    $subdir .= "/" if $subdir && $subdir !~ m|/$|;
X    $libdir .= "/" if $libdir && $libdir !~ m|/$|;
X
X    # Gather files info for the lib dir.
X    local (@files, @found, $pat);
X
X    # Get all filenames.
X    opendir (DIR, $libdir.$subdir);
X    @files = readdir (DIR);
X    closedir (DIR);
X    local ($tmp) = 0+@files if $opt_debug;
X    return @retval unless @files > 0;    # No need to proceed.
X
X    # Form pattern to match search arg.
X    ($pat = $tryfile) =~ s/(\W)/\\\1/g;
X
X    # Extract valid items.
X    @found = grep(/^$pat/, @files);
X    print STDOUT ("Found ", 0+@found, " candidates out of ", $tmp, " files.\n")
X    if $opt_debug;
X    @files = ();        # Deallocate.
X
X    return @retval unless @found > 0;    # No need to proceed.
X
X    foreach $file ( @found ) {
X
X    local ($base, $version, $extension);
X
X    (($base, $version, $extension) =
X     $file =~ /^($pat)(-\d.*|)$extpat$/)
X        || (($base, $version, $extension) =
X        $file =~ /^($pat)(-\d.*|)$/);
X
X    # Nope.
X    next unless defined $base;
X
X    $extension = "" unless defined $extension;
X
X    # Recurse if directory.
X    if ( -d $libdir.$subdir.$file && -r _ ) {
X        print STDOUT ("File $libdir$subdir$file (directory)\n")
X        if $opt_debug;
X        push (@retval,
X          &dirsearch ($libdir, "$subdir$file/$tryfile"));
X        next;
X    }
X
X    # Try file.
X    next unless -f _ && -r _ ;
X
X    # We have a file.
X    @a = stat(_);
X    print STDOUT ("File $libdir$subdir$file (known)\n")
X        if $opt_debug;
X    push (@retval,
X          &zp ($base.$version.$extension, $a[7], $a[9], $libdir, $subdir));
X    }
X
X    return @retval;
X}
X
X1;
END_OF_FILE
  if test 2649 -ne `wc -c <'pr_dsearch.pl'`; then
    echo shar: \"'pr_dsearch.pl'\" unpacked with wrong size!
  fi
  # end of 'pr_dsearch.pl'
fi
if test -f 'pr_isearch.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'pr_isearch.pl'\"
else
  echo shar: Extracting \"'pr_isearch.pl'\" \(2320 characters\)
  sed "s/^X//" >'pr_isearch.pl' <<'END_OF_FILE'
X# pr_isearch.pl -- index search
X# SCCS Status     : @(#)@ pr_isearch.pl    3.2
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 22:13:56 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Wed Jun 10 12:00:11 1992
X# Update Count    : 6
X# Status          : OK
X
Xsub indexsearch {
X
X    local ($ixfile, $lib, $request) = @_;
X
X    # Locate an archive item $request in library $libdir by
X    # inspecting the associated index file.
X    # Eligible items are in the format XXX.EXT, or XXX-VVV.EXT, where
X    # VVV is assumed to be a version indicator (and must start with a digit).
X    #
X    # See "sub search" for a description of the return values.
X
X    return () unless -s $ixfile;
X
X    # Lookup a request in index.
X
X    local ($tryfile, $subdir, $pat);
X    local (@retval);        # return value
X
X    # Normalize the request.
X    ($subdir, $tryfile) = &fnsplit ($request);
X    $pat = $subdir ne "" ? "$subdir/$tryfile" : $tryfile;
X    $pat =~ s/(\W)/\\\1/g;
X
X    print STDOUT ("Lookup $tryfile ($pat) in $ixfile...\n") if $opt_debug;
X
X    # GNU locate 3.6 (or a customized version of GNU locate 3.5)
X    # will return info.
X    $ENV{"LOCATE_DB"} = $ixfile;
X    open (INDEX, "$ixlookup '$tryfile' |");
X
X    local ($base, $version, $extension);
X    local ($date, $size, $file);
X
X    while ( <INDEX> ) {
X    chop;
X
X    # Returned info: path?size in K?mdate, e.g.
X    # zoo-2.01/zoo.TZ?172?910807
X
X    ($file, $size, $date) = /^(.+)\?(\d+)\?(\d+)$/;
X
X    if ( defined $file ) {
X
X        (($base, $version, $extension) =
X         $file =~ m:^($pat|.+/$pat)(-\d[^/]*|)$extpat$:)
X        || (($base, $version, $extension) =
X            $file =~ m:^($pat|.+/$pat)(-\d[^/]*|)$:);
X
X        # Nope.
X        next unless defined $base;
X        $file = $base;
X
X        # Adjust XX -YYY.tar .Z -> XX -YYY .tar.Z
X        $extension = "" unless defined $extension;
X        ($version, $extension) = ($`, $&.$extension)
X        if $extension eq ".Z" && $version =~ /\.(sh|t)ar$/;
X
X        $date =~ s|^(..)(..)(..)|1900+$1."/$2/$3"|e;
X
X        ($subdir, $base) = &fnsplit ($file);
X        $subdir .= "/" if $subdir ne "";
X        $lib .= "/" unless $lib =~ m|/$|;
X
X        push (@retval,
X          &zp ($base.$version.$extension, $size."K", "T".$date,
X               $lib, $subdir));
X        next;
X    }
X
X    }
X
X    close (INDEX);
X    print STDOUT ("Found ", 0+@retval, " entries\n") if $opt_debug;
X    @retval;
X}
X
X1;
END_OF_FILE
  if test 2320 -ne `wc -c <'pr_isearch.pl'`; then
    echo shar: \"'pr_isearch.pl'\" unpacked with wrong size!
  fi
  # end of 'pr_isearch.pl'
fi
if test -f 'report.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'report.pl'\"
else
  echo shar: Extracting \"'report.pl'\" \(6484 characters\)
  sed "s/^X//" >'report.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# report.pl -- make mail server report
X# SCCS Status     : @(#)@ report    3.6
X# Author          : Johan Vromans
X# Created On      : Sat May  2 14:23:10 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Tue May 12 23:09:50 1992
X# Update Count    : 45
X# Status          : Unknown, Use with caution!
X
X# Read the mail server logfile, and create a report.
X
X$my_name = "report";
X$my_version = "3.6";
X#
X################ Common stuff ################
X
X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
Xunshift (@INC, $libdir);
Xrequire "mserv_common.pl";
X
X################ Options handling ################
X
X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
X$opt_usage = 1 unless $opt_errors;
X@ARGV = ( $logfile ) unless @ARGV > 0;
X$now = time;
X
X################ Preamble ################
X
Xrequire "$libdir/rfc822.pl";
X
Xformat std_hdr =
XMail Server Report for @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<     @>>>>>>>>>>>>
X"$thismonth 19$year -- by $report_type", "Page $%"
X
X                                                         1111111111222222222233
X@<<<<<<<<<<<<<<<<<<<                 Type Total 1234567890123456789012345678901
X$report_type
X-------------------------------------------------------------------------------
X.
X
Xformat std_out =
X^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @ @>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X$item, $type, $count, $seq
X ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
X$item
X.
X
X################ Main ################
X
X$logfile = $ARGV[0] if @ARGV == 1;
X
Xopen (LOG, $logfile) || die ("$my_name: Cannot open $logfile [$!]\n");
X
X$curmonth = "";
X@mnames = split (/,/, "January,February,March,April,May,June," .
X        "July,August,September,October,November,December");
X
X# Form pattern for the known libraries so we can easily
X# strip them off the names of the requests.
X$libpat = "(";
Xforeach $lib ( @libdirs ) {
X    $lib =~ s/(\W)/\\\1/g;
X    $libpat .= $lib . "|";
X}
Xchop ($libpat);
X$libpat .= ")";
X
X# Process logfile.
X$msgcnt = 0;
Xwhile ( <LOG> ) {
X
X    # 891002 19:48 M "Neil Dixon <neil@yc1>" /u2/goodies/gwm/INDEX U1/1 32678
X    #    0     1   2             3                  4                5    6
X
X    # Note: $size is not used (yet).
X    ($date, $time, $type, $user, $pkg, $part, $size) =
X    /^(\S+)\s+(\S+)\s(\S)\s+"([^\042]+)"\s+(\S+)\s+(\S+)\s+(\S+)$/;
X
X    unless ( defined $user ) {    # Assume error record.
X
X    next unless $opt_errors;
X
X    ($date, $time, $msg) =
X        /^(\S+)\s+(\S+)\s+(.+)$/;
X    $date .= " " . $time;
X    next if $since && $date lt $since;
X
X    if ( $msgcnt == 0 && $since ) {
X        print STDERR ("Errors since $since\n\n");
X    }
X    print STDERR ($date, " ", $msg, "\n");
X    $msgcnt++;
X    next;
X    }
X
X    next unless $opt_usage;
X
X    # Use first parts for accounting only.
X    next unless $part =~ m|^\w*1/|;
X
X    # Get date.
X    $year = substr ($date, 0, 2);
X    $month = substr ($date, 2, 2);
X    $day = substr ($date, 4, 2);
X
X    # Strip known libraries.
X    $pkg = $' if $pkg =~ /$libpat\//o;
X    $pkg .= $type;
X
X    # Generate a new report page if the month runs over.
X    if ( $curmonth ne $month ) {
X    if ( $curmonth ne "" ) {
X        &report;
X        $- = 0;            # Force page break.
X        reset "Z";
X    }
X    $curmonth = $month;
X    $thismonth = $mnames[$curmonth-1];
X    $weeksh = &firstday ($month, $year);
X    }
X
X    # Normalize addresses and count them.
X    &rfc822'parse_addresses ($user);
X    $user = $rfc822'addresses[0] . $type;
X    $Zucounts{$user}++;
X    $Zudays{$user} |= 1 << ($day - 1);
X    $Zpcounts{$pkg}++;
X    $Zpdays{$pkg} |= 1 << ($day - 1);
X}
Xclose (LOG);
X
X# Update since-file.
Xif ( $opt_since && !$opt_noupdate ) {
X    utime ($now, $now, $opt_since) ||
X    print STDERR ("Cannot change times on \"$opt_since\" [$!]\n");
X}
X
X# Now for the remaining usage reports ...
X&report if $opt_usage;
X
X# That's it ...
Xexit (0);
X
X################ Subroutines ################
X
Xsub report {
X    $^ = "std_hdr";
X    $~ = "std_out";
X    $: = " \n-/";
X    &report1;
X    &report2;
X}
X
Xsub report1 {
X    $report_type = "User";
X    $- = 0;
X    $% = 0;
X    foreach $item (sort (keys (%Zucounts))) {
X    $seq = &daylist ($Zudays{$item});
X    $count = $Zucounts{$item};
X    $type = chop ($item);
X    write;
X    }
X}
X
Xsub report2 {
X    $report_type = "Package";
X    $- = 0;
X    $% = 0;
X    foreach $item (sort (keys (%Zpcounts))) {
X    $seq = &daylist ($Zpdays{$item});
X    $count = $Zpcounts{$item};
X    $type = chop ($item);
X    write;
X    }
X}
X
Xsub daylist {
X    local ($day) = pop (@_);
X    local ($seq) = "";
X    local ($cc) = 1;
X
X    while ( $cc <= 31 ) {
X    if ( $day & 0x1 ) {
X        $seq .= substr ("SMTWTFS", ($cc - $weeksh + 7) % 7, 1);
X    }
X    else {
X        $seq = "$seq ";
X    }
X    $day >>= 1;
X    $cc++;
X    }
X    return $seq;
X}
X
Xsub firstday {
X    local ($month) = shift (@_);
X    local ($year) = shift (@_);
X    local ($t);
X    local (@tm);
X
X    $t =
X    ($year - 70) * (365 * 24 * 60 * 60) +
X        ($month - 1) * (28 * 24 * 60 * 60);
X    $month--;
X
X    do {
X    @tm = localtime ($t);
X    $t += (28 * 24 * 60 * 60);
X    }
X    while (($tm[5] < $year) || ($tm[4] < $month));
X
X    $t = ($tm[3] - $tm[6]) % 7;
X    $t += 7 if $t < 0;
X    return $t;
X}
X
Xsub options {
X    local ($opt_full, $opt_help, $opt_ident) = (0, 0, 0);
X
X    require "newgetopt.pl";
X
X    $opt_errors = $opt_usage = 0;
X    if ( !&NGetOpt ("ident", "errors", "usage", "full",
X            "since=s", "noupdate",
X            "help")
X    || $opt_help
X    || (@ARGV > 1)) {
X    &usage;
X    }
X    $opt_errors |= $opt_full;
X    $opt_usage |= $opt_full;
X    print ($my_package, " [", $my_name, " ", $my_version, "]\n")
X    if $opt_ident && $opt_usage;
X    print STDERR ($my_package, " [", $my_name, " ", $my_version, "]\n")
X    if $opt_ident && $opt_errors;
X    if ( defined $opt_since ) {
X    local ($a) = (stat ($opt_since))[9];
X    die ("Cannot timestamp \"$opt_since\" [$!]\n") unless $a > 0;
X    local (@tm) = localtime ($a);
X    $since = sprintf ("%02d%02d%02d %02d:%02d",
X              $tm[5], 1+$tm[4], $tm[3], $tm[2], $tm[1]);
X    $opt_noupdate = defined $opt_noupdate;
X    }
X    else {
X    $since = "";
X    }
X}
X
Xsub usage {
X    print STDERR <<EndOfUsage;
X$my_package [$my_name $my_version]
X
XUsage: $my_name [options] [ logfile ]
X
XOptions:
X    -errors    generate error report to STDERR
X    -usage    generate usage report to STDOUT
X    -full    generate usage report and error report
X    -since FILE    only error messages newer than FILE
X        (FILE date will be updated upon successful completion)
X    -noupdate    do not update FILE
X    -help    this message
X    -ident    print program identification
X
XDefault action is to generate a usage report from logfile
X"$logfile".
XEndOfUsage
X    exit (1);
X}
END_OF_FILE
  if test 6484 -ne `wc -c <'report.pl'`; then
    echo shar: \"'report.pl'\" unpacked with wrong size!
  fi
  # end of 'report.pl'
fi
if test -f 'rfc822.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'rfc822.pl'\"
else
  echo shar: Extracting \"'rfc822.pl'\" \(4456 characters\)
  sed "s/^X//" >'rfc822.pl' <<'END_OF_FILE'
X# rfc822.pl -- RFC822 support
X# SCCS Status     : @(#)@ rfc822    2.2
X# Author          : Johan Vromans
X# Created On      : Oct 26 20:39:18 1989
X# Last Modified By: Johan Vromans
X# Last Modified On: Thu Apr 30 14:56:44 1992
X# Update Count    : 29
X# Status          : OK
X#
X# Copyright 1989, 1992 Johan Vromans
X#
X# This software may be redistributed on the same terms as the
X# GNU Public Licence.
X
X# Exported routines
X#
X#   start_read -- initializes this module
X#
X#    must be passed the filename to read from
X#
X#   read_header -- reads, and parses RFC822 header
X#
X#    returns $VALID_HEADER if a valid RFC822 header was found.
X#    $header and $contents contain the header and contents.
X#    $line contains the normalized header.
X#
X#   read_body -- reads a line from the message body
X#
X#    returns $EMPTY_LINE if an empty line was read.
X#
X#    returns $DATA_LINE otherwise.
X#    $line contains the contents of the line.
X#
X#   parse_addresses -- parses an address specification.
X#
X#    return addresses in @addresses, the address
X#    comments in %addr_comments.
X#
X
X# Export the routines in the requiring package.
X*start_read = *rfc822'start_read;
X*read_header = *rfc822'read_header;
X*read_body = *rfc822'read_body;
X*parse_addresses = *rfc822'parse_addresses;
X
X# Switch to package context.
Xpackage rfc822;
X
X$[ = 0;                # let arrays start at 0 ];
X
X################ Global constants ################
X$EOF = 0;
X$VALID_HEADER = 1;
X$EMPTY_LINE = 2;
X$DATA_LINE = 3;
X
X################ Variables ################
X$version = "@(#)@ rfc822    2.2 - rfc822.pl";
Xundef $line_in_cache;
X$have_input_stream = 0;
X$line = "";
X$header = "";
X$contents = "";
X@addresses = ();
X%addr_comments = ();
Xlocal (*INPUT);
X
X################ Subroutines ################
X
Xsub start_read {
X    local ($file) = @_;
X
X    close (INPUT) if $have_input_stream;
X
X    return 0 unless open (INPUT, $file);
X
X    # Initialize the read ahead system.
X    $line_in_cache = <INPUT>;
X
X    # Will supply return value.
X    $have_input_stream = 1;
X}
X
Xsub read_body {
X
X    if ( defined $line_in_cache ) {
X    $line = $line_in_cache;
X    undef $line_in_cache;
X    }
X    else {
X    return $EOF if eof(INPUT);
X    $line = <INPUT>;
X    }
X
X    chop ($line);
X    $header = $contents = undef;
X    return ($line eq "") ? $EMPTY_LINE : $DATA_LINE;
X}
X
Xsub read_header {
X
X    if ( defined $line_in_cache ) {
X    $line = $line_in_cache;
X    undef $line_in_cache;
X    }
X    else {
X    return $EOF if eof(INPUT);
X    $line = <INPUT>;
X    }
X
X    chop ($line);
X    if ( $line =~ /^([-\w]+)\s*:\s*/ ) {
X    $header = $1;
X    $contents = $';            #';
X    }
X    else {
X    $header = $contents = undef;
X    return ($line eq "") ? $EMPTY_LINE : $DATA_LINE;
X    }
X
X    # Handle continuation lines.
X    while ( ! eof(INPUT) ) {
X    chop ($line = <INPUT>);
X    if ( $line =~ /^\s+/ ) {
X        # Append.
X        $contents .= " " . $';        #';
X    }
X    else {
X        # Too far.
X        $line_in_cache = $line . "\n";
X        last;
X    }
X    }
X
X    $line = $header . ": " . $contents;
X    return $VALID_HEADER;
X}
X
Xsub parse_addresses {
X
X    # Given an RFC822 compliant series of addresses, parse them, and
X    # return:
X    #    @addresses -- array with parsed addresses.
X    #    %addr_comments -- the comments for each of the addresses.
X    #
X    # RFC822 syntax:
X    #    address [, address ...]
X    #    address: addr [ ( comment ) ] | [ comment ] <addr>
X
X    local ($addr) = shift (@_);
X    local ($left);
X    local (@left);
X    local ($right);
X    local ($comment);
X
X    @addresses = ();
X    %addr_comments = ();
X
X    # First break out the (...) comments.
X    while ( $addr =~ /\(([^)]*)\)/ ) {
X    $right = $';
X    $comment = $1;
X    @left = split (/[ \t]+/, $`);
X    if ( $#left >= 0 ) {
X        # print "() match: \"", $left[$#left], "\" -> \"$1\"\n";
X        unshift (@addresses, pop (@left));
X        $addr_comments{$addresses[0]} = $1;
X    }
X    if ( $right =~ /^\s*,\s*/ ) {
X        $right = $';
X    }
X    $addr = join (" ", @left) . " " . $right;
X    # print "todo: $addr\n";
X    }
X
X    # Then split on commas, and handle each part separately.
X    @addr = split (/,/, $addr);
X
X    while ( $#addr >= 0 ) {
X    $addr = shift (@addr);
X    # print "doing: \"$addr\"\n";
X    $addr = $' if $addr =~ /^\s+/ ;
X    $addr = $` if $addr =~ /\s+$/ ;
X    next if $addr eq "";
X    if ( $addr =~ /<([^>]+)>/ ) {
X        # print "\"$addr\" matched: \"$`\"-\"$+\"-\"$'\"\n";
X        unshift (@addresses, $1);
X        $addr_comments{$1} = join (" ", split (/[ \t]+/, "$` $'"));
X    }
X    else {
X        unshift (@addresses, $addr);
X        $addr_comments{$addr} = "";
X        # print "did: \"$addr\"\n";
X    }
X    }
X}
X
X1;
END_OF_FILE
  if test 4456 -ne `wc -c <'rfc822.pl'`; then
    echo shar: \"'rfc822.pl'\" unpacked with wrong size!
  fi
  # end of 'rfc822.pl'
fi
if test -f 'testlock.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'testlock.pl'\"
else
  echo shar: Extracting \"'testlock.pl'\" \(1542 characters\)
  sed "s/^X//" >'testlock.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl -s
X# testlock.pl -- test locking
X# SCCS Status     : @(#)@ testlock    1.1
X# Author          : Johan Vromans
X# Created On      : Thu Jun  4 21:22:45 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Sat Jun  6 20:55:39 1992
X# Update Count    : 64
X# Status          :
X
X# Simpel testbed for mail server locking.
X#
X# To test, execute
X#
X#   % perl -s testlock.pl -test1 &
X#
X# It should say "Got the lock -- waiting ...".
X# Then execute
X#
X#   % perl -s testlock.pl -test2 &
X#
X# It should say "Good. Could not lock -- waiting ...".
X# Now kill the first process. The second process should print "ret = 1"
X# and exit.
X
X$my_name = "testlock";
X$my_version = "1.1";
X#
X################ Common stuff ################
X
X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
Xunshift (@INC, $libdir);
Xrequire "mserv_common.pl";
X
X################ Main ################
X
X$tf = "/usr/tmp/f1lock";
X
Xif ( defined $test1 ) {
X
X    open ( F1, ">$tf");
X
X    local ($ret) =  &locking (*F1, 0);
X    if ( $ret == 1 ) {
X    print ("Got the lock -- waiting ...\n");
X    sleep 600;
X    close (F1);
X    unlink ($tf);
X    exit (0);
X    }
X
X    print ("Locking problem: ret = $ret [$!]\n");
X}
X
Xif ( defined $test2 ) {
X
X    open (F2, "+<$tf") || print ("Cannot open $tf [$!]\n");
X
X    local ($ret) = &locking (*F2, 0);
X    if ( $ret == 0 ) {
X    print ("Good, could not lock -- waiting ...\n");
X    $ret = &locking (*F2, 1);
X    print ("Ret = $ret\n");
X    close (F2);
X    unlink ($tf);
X    exit (0);
X    }
X
X    print ("Cannot lock exclusive: ret = $ret [$!]\n");
X    close (F2);
X}
END_OF_FILE
  if test 1542 -ne `wc -c <'testlock.pl'`; then
    echo shar: \"'testlock.pl'\" unpacked with wrong size!
  fi
  # end of 'testlock.pl'
fi
echo shar: End of archive 3 \(of 4\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 4 archives.
    rm -f ark[1-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...